home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Oberon0 / OS.mod < prev    next >
Encoding:
Text File  |  1995-05-31  |  6.6 KB  |  252 lines
  1. <* REGISTER- *>
  2.  
  3. MODULE OS;  (*HM Mar-25-92, fjc 15/4/95*)
  4. IMPORT SYSTEM, Display, Files, Fonts, Input := InputPO, Types, Modules;
  5.  
  6. CONST
  7.   left* = 2; middle* = 1; right* = 0; (*mouse button codes*)
  8.   ticks* = 300;  (*time unit of OS.Time = 1/ticks*)
  9.  
  10. TYPE
  11.   File* = Files.File;
  12.   Font* = Fonts.Font;
  13.   Object* = POINTER TO ObjectDesc;
  14.   ObjectDesc* = RECORD END;
  15.   Message* = RECORD END;
  16.   Pattern* = Display.Pattern;
  17.   Rider* = RECORD (Files.Rider)
  18.     tab: ARRAY 16, 32 OF CHAR;
  19.     end: INTEGER
  20.   END;
  21.  
  22. VAR
  23.   screenH-, screenW-: INTEGER;
  24.   Caret-: Display.Pattern; (* x = 0, y = -10, w = 12, h = 12 *)
  25.   barH-, minH- : INTEGER;
  26.   
  27. (*Object*)
  28.  
  29. PROCEDURE (x: Object) Load* (VAR r: Rider); END Load;
  30.  
  31. PROCEDURE (x: Object) Store* (VAR r: Rider); END Store;
  32.  
  33. (*Rider*)
  34.  
  35. PROCEDURE (VAR r: Rider) Set* (f: File; pos: LONGINT);
  36. BEGIN Files.Set(r, f, pos)
  37. END Set;
  38.  
  39. PROCEDURE (VAR r: Rider) Read* (VAR x: CHAR);
  40. BEGIN Files.Read(r, x)
  41. END Read;
  42.  
  43. PROCEDURE (VAR r: Rider) ReadChars* (VAR x: ARRAY OF CHAR; n: LONGINT);
  44. BEGIN Files.ReadBytes(r, x, n)
  45. END ReadChars;
  46.  
  47. PROCEDURE (VAR r: Rider) ReadLInt* (VAR x: LONGINT);
  48.   VAR n: LONGINT; s: INTEGER; ch: CHAR;
  49. BEGIN
  50.   s := 0; n := 0; Files.Read(r, ch);
  51.   WHILE ORD(ch) >= 128 DO
  52.     INC(n, ASH(ORD(ch) - 128, s)); INC(s, 7); Files.Read(r, ch)
  53.   END;
  54.   x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s)
  55. END ReadLInt;
  56.  
  57. PROCEDURE (VAR r: Rider) ReadInt* (VAR x: INTEGER);
  58.   VAR n: LONGINT;
  59. BEGIN r.ReadLInt(n); x := SHORT(n)
  60. END ReadInt;
  61.  
  62. PROCEDURE (VAR r: Rider) ReadString* (VAR name: ARRAY OF CHAR);
  63.   VAR i: INTEGER; ch: CHAR;
  64. BEGIN r.Read(ch);
  65.   IF ORD(ch) = r.end THEN
  66.     i := -1; REPEAT INC(i); r.Read(name[i]) UNTIL name[i] = 0X;
  67.     COPY(name, r.tab[r.end]); INC(r.end)
  68.   ELSE COPY(r.tab[ORD(ch)], name)
  69.   END
  70. END ReadString;
  71.  
  72. PROCEDURE (VAR r: Rider) ReadObj* (VAR x: Object);
  73.   VAR name1, name2: ARRAY 32 OF CHAR; type: Types.Type;
  74. BEGIN r.ReadString(name1);
  75.   IF name1 = "" THEN x := NIL
  76.   ELSE r.ReadString(name2); type := Types.This(Modules.ThisMod(name1), name2);
  77.     Types.NewObj(x, type); x.Load(r)
  78.   END
  79. END ReadObj;
  80.  
  81. PROCEDURE (VAR r: Rider) Write* (x: CHAR);
  82. BEGIN Files.Write(r, x)
  83. END Write;
  84.  
  85. PROCEDURE (VAR r: Rider) WriteChars* (VAR x: ARRAY OF CHAR; n: LONGINT);
  86. BEGIN Files.WriteBytes(r, x, n)
  87. END WriteChars;
  88.  
  89. PROCEDURE (VAR r: Rider) WriteLInt* (x: LONGINT);
  90. BEGIN
  91.   WHILE (x < -64) OR (x > 63) DO
  92.     Files.Write(r, CHR(x MOD 128 + 128)); x := x DIV 128
  93.   END;
  94.   Files.Write(r, CHR(x MOD 128))
  95. END WriteLInt;
  96.  
  97. PROCEDURE (VAR r: Rider) WriteInt* (x: INTEGER);
  98. BEGIN r.WriteLInt(x)
  99. END WriteInt;
  100.  
  101. PROCEDURE (VAR r: Rider) WriteString* (name: ARRAY OF CHAR);
  102.   VAR i: INTEGER;
  103. BEGIN i := 0;
  104.   LOOP
  105.     IF i = r.end THEN r.Write(CHR(i));
  106.       i := -1; REPEAT INC(i); r.Write(name[i]) UNTIL name[i] = 0X;
  107.       COPY(name, r.tab[r.end]); INC(r.end); EXIT
  108.     ELSIF r.tab[i] = name THEN r.Write(CHR(i)); EXIT
  109.     ELSE INC(i)
  110.     END
  111.   END
  112. END WriteString;
  113.  
  114. PROCEDURE (VAR r: Rider) WriteObj* (x: Object);
  115.   VAR type: Types.Type;
  116. BEGIN
  117.   IF x = NIL THEN r.Write(0X)
  118.   ELSE type := Types.TypeOf(x); r.WriteString(type.module.name); r.WriteString(type.name);
  119. x.Store(r)
  120.   END
  121. END WriteObj;
  122.  
  123. PROCEDURE InitRider* (VAR r: Rider);
  124. BEGIN r.tab[0] := ""; r.end := 1
  125. END InitRider;
  126.  
  127. (*other procedures*)
  128.  
  129. PROCEDURE FillBlock* (X, Y, W, H: INTEGER);
  130. BEGIN Display.ReplConst (Display.white, X, Y, W, H, Display.replace)
  131. END FillBlock;
  132.  
  133. PROCEDURE EraseBlock* (X, Y, W, H: INTEGER);
  134. BEGIN Display.ReplConst (Display.black, X, Y, W, H, Display.replace)
  135. END EraseBlock;
  136.  
  137. PROCEDURE InvertBlock* (X, Y, W, H: INTEGER);
  138. BEGIN Display.ReplConst (Display.white, X, Y, W, H, Display.invert)
  139. END InvertBlock;
  140.  
  141. PROCEDURE CopyBlock* (SX, SY, W, H, DX, DY: INTEGER);
  142. BEGIN Display.CopyBlock (SX, SY, W, H, DX, DY, Display.replace)
  143. END CopyBlock;
  144.  
  145. PROCEDURE DrawPattern* (pat: Pattern; x, y: INTEGER);
  146. BEGIN Display.CopyPattern(Display.white, pat, x, y, Display.invert)
  147. END DrawPattern;
  148.  
  149. PROCEDURE GetCharMetric* (f: Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR
  150. pat: LONGINT);
  151. BEGIN Display.GetChar(f.raster, ch, dx, x, y, w, h, pat)
  152. END GetCharMetric;
  153.  
  154. PROCEDURE OldFile* (name: ARRAY OF CHAR): File;
  155. BEGIN RETURN Files.Old(name)
  156. END OldFile;
  157.  
  158. PROCEDURE NewFile* (name: ARRAY OF CHAR): File;
  159. BEGIN RETURN Files.New(name)
  160. END NewFile;
  161.  
  162. PROCEDURE Register* (f: File);
  163. BEGIN Files.Register(f)
  164. END Register;
  165.  
  166. PROCEDURE DefaultFont* (): Font;
  167. BEGIN RETURN Fonts.Default
  168. END DefaultFont;
  169.  
  170. PROCEDURE FontWithName* (name: ARRAY OF CHAR): Font;
  171. BEGIN RETURN Fonts.This(name)
  172. END FontWithName;
  173.  
  174. PROCEDURE GetMouse* (VAR buttons: SET; VAR x, y: INTEGER);
  175. BEGIN Input.Mouse(buttons, x, y)
  176. END GetMouse;
  177.  
  178. PROCEDURE AvailChars* (): INTEGER;
  179. BEGIN RETURN Input.Available()
  180. END AvailChars;
  181.  
  182. PROCEDURE ReadKey* (VAR ch: CHAR);
  183. BEGIN Input.Read(ch)
  184. END ReadKey;
  185.  
  186. PROCEDURE FadeCursor*;
  187. END FadeCursor;
  188.  
  189. PROCEDURE DrawCursor* (x, y: INTEGER);
  190. END DrawCursor;
  191.  
  192. PROCEDURE Call* (command: ARRAY OF CHAR);
  193.   VAR mod : Modules.Module; cmd : Modules.Command; i, j: INTEGER;
  194. BEGIN
  195.   i := 0; j := 0;
  196.   WHILE command[j] # 0X DO
  197.     IF command[j] = "." THEN i := j END;
  198.     INC(j)
  199.   END;
  200.   IF i > 0 THEN
  201.     command[i] := 0X;
  202.     mod := Modules.ThisMod(command);
  203.     IF Modules.res = 0 THEN
  204.       INC(i); j := i;
  205.       WHILE command[j] # 0X DO command[j - i] := command[j]; INC(j) END;
  206.       command[j - i] := 0X;
  207.       cmd := Modules.ThisCommand(mod, command);
  208.       IF Modules.res = 0 THEN cmd END
  209.     END
  210.   END
  211. END Call;
  212.  
  213. PROCEDURE Time* (): LONGINT;
  214. BEGIN RETURN 0
  215. END Time;
  216.  
  217. PROCEDURE NameToObj* (name: ARRAY OF CHAR; VAR obj: Object);
  218.   VAR type: Types.Type; mod: Modules.Module; i, j: INTEGER; tname: ARRAY 32
  219. OF CHAR;
  220. BEGIN
  221.   i := 0; WHILE (name[i] # 0X) & (name[i] # ".") DO INC(i) END;
  222.   IF name[i] = "." THEN
  223.     name[i] := 0X; INC(i); j := 0;
  224.     WHILE name[i] # 0X DO tname[j] := name[i]; INC(i); INC(j) END;
  225.     tname[j] := 0X;
  226.     mod := Modules.ThisMod(name); type := NIL;
  227.     IF mod # NIL THEN type := Types.This(mod, tname) END;
  228.     IF type # NIL THEN Types.NewObj(obj, type) ELSE obj := NIL END
  229.   ELSE obj := NIL
  230.   END
  231. END NameToObj;
  232.  
  233. PROCEDURE Move* (VAR fromBuf: ARRAY OF CHAR; from: LONGINT; VAR toBuf: ARRAY OF CHAR; to, n: LONGINT);
  234.   VAR d: LONGINT;
  235. BEGIN
  236.   from := SYSTEM.VAL (LONGINT, SYSTEM.ADR(fromBuf)) + from;
  237.   to := SYSTEM.VAL (LONGINT, SYSTEM.ADR(toBuf)) + to;
  238.   IF from < to THEN d := to - from; from := from + n; to := to + n;
  239.     WHILE n > 0 DO IF d > n THEN d := n END;
  240.       from := from - d; to := to - d;
  241.       SYSTEM.MOVE(from, to, d); n := n - d
  242.     END
  243.   ELSIF from > to THEN SYSTEM.MOVE(from, to, n)
  244.   END
  245. END Move;
  246.  
  247. BEGIN
  248.   screenH := Display.Height; screenW := Display.Width;
  249.   Caret := Display.hook;
  250.   barH := Fonts.Default.height + 2; minH := barH + 2
  251. END OS.
  252.